home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / autodesk.arc / R-SURF.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1987-09-02  |  11.2 KB  |  382 lines
  1. ;********************* R-SURF.LSP ******************************************
  2. ;
  3. ;  Function to create a "rotated surface" from a profile polyline,
  4. ,   a center line, and a center point.
  5. ;  The "surface" is created using 3dface entities, and is currently
  6. ;   rotated only about a z-axis.  The general case (about any axis)
  7. ;   is left as an exercise.
  8. ;
  9. ;
  10. ; by Simon Jones - Autodesk UK Ltd.
  11. ;   embellished by John Lynch - Autodesk, Inc.
  12. ;   modified by JCG & TK 6/28/87 - Autodesk, Inc.
  13. ;   further modified by Duff Kurland 7/20/87 - Autodesk, Inc.
  14. ;
  15. ;  This file contains a number of functions, which are called from the main
  16. ;   and other functions.  The use of the functions are documented in the
  17. ;   accompanying comments.
  18. ;
  19. ;  SEMI-GLOBAL VARIABLES:
  20. ;
  21. ;   cen:        center point of surface generation in the x-y plane
  22. ;   lat:        Lateral constant for control of segmentation of arc segments
  23. ;   segno:      Radial segmentation constant
  24. ;   div:        Number of divisions to fill the desired sweep angle
  25. ;   array-deg:  Number of degrees for the circular array
  26. ;   v1list:     Vertex no. 1 entity list
  27. ;   v2list:     Vertex no. 2 entity list
  28. ;   p:          profile polyline entity name
  29. ;   cenx:       Center point for the array
  30. ;   cx:         x-coordinate of the start point of the center line
  31. ;   cy:         y-coordinate of the start point of the center line
  32. ;   minrad:     dist from the center line to the last point on the profile
  33. ;   maxrad:     dist from the center line to the current point on the profile
  34. ;   elev:       current incremental elevation
  35. ;   h:          vertical increment from last to current point on profile
  36. ;   cflag:      closed polyline flag
  37.  
  38.  
  39. ; Construct a single 3DFACE segment
  40.  
  41. (defun dseg ( / pt1 pt2 pt3 pt4)
  42.          (setq pt1 (polar cen 0 minrad))
  43.          (setq pt2 (polar cen 0 maxrad))
  44.          (setq pt3 (polar cen div maxrad))
  45.          (setq pt4 (polar cen div minrad))
  46.          (command "3DFACE"
  47.                   (list (car pt1) (cadr pt1) (+ elev h))
  48.                   (list (car pt2) (cadr pt2) elev )
  49.                   (list (car pt3) (cadr pt3) elev )
  50.                   (list (car pt4) (cadr pt4) (+ elev h))
  51.          )
  52.          (command "")
  53. )
  54.  
  55. ;  Function to handle a linear segment of a polyline
  56.  
  57. (defun linseg()
  58.     (setq maxrad (- (car cenx) (cadr (assoc 10 v1list))))
  59.     (setq minrad (- (car cenx) (cadr (assoc 10 v2list))))
  60.     (setq h (- (caddr (assoc 10 v2list))
  61.                (caddr (assoc 10 v1list))
  62.             )
  63.     )
  64.     (dseg)
  65.     (setq elev (+ elev h))               ; reset the elevation for next seg
  66. )
  67.  
  68. ;  Function to handle a polyline arc segment.
  69. ;
  70. ; s  : Starting point
  71. ; e  : Ending point
  72. ; b  : Bulge of arc
  73. ;
  74. ; Calculate the included angle, midpoint between vertices,
  75. ; and the directional angle from the starting to ending vertex
  76.  
  77. (defun arcseg (s e b / iang mpt dang cpt rad mpt nseg bpt ept dd )
  78.   (setq iang (* 4.0 (atan (abs b)))
  79.         mpt  (midpt s e)
  80.         dang (angle s e)
  81.   )
  82.  
  83.   ; find the center and radius of the arc
  84.   (if (< (abs b) 1)      ; if the bulge is > 1
  85.     (progn               ;  use the complementary arc
  86.       (setq rad (/ (/ (distance s e) 2.0) (sin (/ iang 2.0)))
  87.             m (* rad (cos (/ iang 2.0)))
  88.       )
  89.       (if (< b 0)             ; clockwise or counterclockwise?
  90.         (setq cpt (polar mpt (- dang (/ pi 2.0)) m))
  91.         (setq cpt (polar mpt (+ dang (/ pi 2.0)) m))
  92.       )
  93.     )     ; end of progn
  94.     (progn               ; otherwise ...
  95.       (setq rad (/ (/ (distance s e) 2.0) (sin (- pi (/ iang 2.0))))
  96.             m (* rad (cos (- pi (/ iang 2.0))))
  97.       )
  98.       (if (< b 0)
  99.         (setq cpt (polar mpt (+ dang (/ pi 2.0)) m))
  100.         (setq cpt (polar mpt (- dang (/ pi 2.0)) m))
  101.       )
  102.     )      ; end of progn
  103.   )        ; end of if
  104.  
  105.   (if (< b 0)
  106.       (setq iang (- 0.0 iang))     ; negative bulge means clockwise arc
  107.   )
  108.  
  109.   ; Set the number of segments according to the value of "lat" (global)
  110.   (setq nseg lat
  111.      dd (/ iang (+ nseg 1))        ; delta angle based on nseg
  112.      bpt s                         ; initialize start point to start of arc
  113.      cnt 0                         ; initialize count to 0
  114.    )
  115.  
  116.   (while (< cnt nseg)
  117.     (setq ept (polar cpt (+ (angle cpt bpt) dd) rad)  ; end of this segment
  118.           maxrad (- (car cenx) (car bpt))
  119.           minrad (- (car cenx) (car ept))
  120.           h (- (cadr ept) (cadr bpt))
  121.     )
  122.     (dseg)
  123.  
  124.     ; Reset the starting point and increment cnt and elev
  125.     (setq bpt ept
  126.           cnt (1+ cnt)
  127.           elev (+ elev h)
  128.     )
  129.   )
  130.  
  131.   ; Do the last segment, which ends on the endpoint of the arc
  132.   (setq ept e
  133.         maxrad (- (car cenx) (car bpt))
  134.         minrad (- (car cenx) (car ept))
  135.         h (- (cadr ept) (cadr bpt))
  136.   )
  137.   (dseg)
  138.   (setq elev (+ elev h))          ; Reset elev
  139. )
  140.  
  141. ; Function to calculate and return the midpoint between two points.
  142.  
  143. (defun midpt(p1 p2 / x1 x2 y1 y2)
  144.   (setq x1 (car p1)
  145.         y1 (cadr p1)
  146.         x2 (car p2)
  147.         y2 (cadr p2)
  148.   )
  149.   (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0))
  150. )
  151.  
  152. ; Convert Degrees to Radians
  153.  
  154. (defun dtr (a)
  155.   (* pi (/ a 180.0))
  156. )
  157.  
  158. ; Convert Radians to Degrees
  159.  
  160. (defun rtd (a)
  161.   (/ (* a 180.0) pi)
  162. )
  163.  
  164. ; Save the SETVARs specified in the mode list into the global MLST.
  165. ; The specified modes must not be read only.  i.e. "CLAYER" should
  166. ; not be included in the list.
  167.  
  168. (defun MODES (a)
  169.    (setq MLST '())
  170.    (repeat (length a)
  171.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  172.       (setq a (cdr a)))
  173. )
  174.  
  175. ; Restore the SETVARs specified in the global MLST.
  176.  
  177. (defun MODER ()
  178.    (repeat (length MLST)
  179.       (setvar (caar MLST) (cadar MLST))
  180.       (setq MLST (cdr MLST))
  181.    )
  182. )
  183.  
  184. ; Function to select the center line of the profile
  185.  
  186. (defun c-line ( / cline clist loop)
  187.     (setq loop T)
  188.     (while loop
  189.       (setq cline (entsel "\nSelect center line: "))
  190.       (if (null (car cline))
  191.           (progn
  192.              (prompt " 1 selected, 0 found.")
  193.              (setq clist '( '(0 . "JUNK")))  ; dummy assoc list for following
  194.                                              ;  test of entity
  195.           )
  196.           (setq clist (entget (car cline)))
  197.       )
  198.       (if (= (cdr (assoc 0 clist)) "LINE")
  199.           (setq loop nil)                    ; all tests pass - exit loop
  200.           (prompt " Entity selected is not a line.")
  201.       )
  202.     )
  203.     (setq cx (cadr (assoc 10 clist))         ; global variables for x & y coord
  204.           cy (caddr (assoc 10 clist))        ;  of start point of center line
  205.     )
  206. )
  207.  
  208. ; Function to select the profile for the surface
  209.  
  210. (defun prosel ( / plist loop)
  211.     (setq cflag nil
  212.           loop  T
  213.     )
  214.     (while loop
  215.       (setq p (entsel "\nSelect Profile: "))   ; global variable for use in
  216.                                                ;   main program
  217.       (if (null (car p))
  218.           (progn
  219.              (prompt " 1 selected, 0 found.")
  220.              (setq plist '( '(0 . "JUNK")))  ; dummy assoc list for following
  221.                                              ;  test of entity
  222.           )
  223.           (setq plist (entget (car p)))
  224.       )
  225.       (if (= (cdr (assoc 0 plist)) "POLYLINE")
  226.           (setq loop nil)                     ; all tests pass - exit loop
  227.           (prompt " Entity selected is not a polyline.")
  228.       )
  229.     )
  230.     (if (= (logand (cdr (assoc 70 plist)) 1) 1)
  231.         (setq cflag 1)
  232.     )
  233. )
  234.  
  235. ;  Get next polyline vertex, ignoring spline control points
  236.  
  237. (defun vertnext (curr / v ve)
  238.     (setq ve (entget (setq v (entnext curr))))
  239.     (while (and (= (cdr (assoc 0 ve)) "VERTEX")
  240.                 (= (logand (cdr (assoc 70 ve)) 16) 16))
  241.        (setq ve (entget (setq v (entnext v))))
  242.     )
  243.     v
  244. )
  245.  
  246. ; Error handler
  247.  
  248. (defun myerror (st)                ; Handle cleanup on CTRL-C
  249.     (moder)
  250.     (terpri)
  251.     (princ (strcat "\nerror: " st "\n"))
  252.     (setq *error* olderr)
  253.     (princ)
  254. )
  255.  
  256. ; MAIN PROGRAM
  257.  
  258. (defun C:R-SURF ( / array-deg bulge cen cenx cflag cx cy c1 c1list
  259.                   deg div e elev h lat maxrad minrad olderr p s segno
  260.                   v1 v1list v2 v2list)
  261.  
  262.    (setq olderr  *error*     ; Establish our error handler
  263.          *error* myerror)
  264.  
  265.    ; Store the system variables changed during the function
  266.  
  267.    (modes '("ELEVATION" "THICKNESS" "CMDECHO" "BLIPMODE" "HIGHLIGHT"))
  268.    (setvar "CMDECHO" 0)
  269.    (setvar "HIGHLIGHT" 0)
  270.  
  271.    (prosel)                  ; Select the profile for the rotated surface
  272.    (c-line)                  ; Select the center line of the profile
  273.  
  274.    ; Select the center point for the construction of the surface  (cen)
  275.  
  276.    (initget (+ 1 16))                 ; 3D point, cannot be null
  277.    (setq cen (getpoint "\nCenter point for construction: "))
  278.  
  279.    ; Enter the sweep angle of the surface  (deg)
  280.  
  281.    (setq deg (getangle cen "\nDegrees of rotation <360>: "))
  282.    (if (null deg)
  283.        (setq deg 360.0)
  284.        (setq deg (rtd deg))
  285.    )
  286.  
  287.    ; Enter the constant to control arc segmentation  (lat)
  288.  
  289.    (initget (+ 2 4))                  ; No negative or zero values
  290.    (setq lat (getint "\nArc segment constant <10>: "))
  291.    (if (null lat)
  292.        (setq lat 10)
  293.    )
  294.  
  295.    ; Enter value to control radial segmentation  (segno)
  296.  
  297.    (initget (+ 2 4))                  ; No negative or zero values
  298.    (setq segno (getint "\nRadial segment constant <15>: "))
  299.    (if (null segno)
  300.        (setq segno 15)
  301.    )
  302.  
  303.    ; Set up the number of divisions from the sweep angle
  304.  
  305.    (setq div (/ deg segno))
  306.    (setq array-deg (- deg div))
  307.    (setq div (dtr div))
  308.  
  309.    (setvar "BLIPMODE" 0)
  310.  
  311.    ; Set the vertices and retrieve vertex data
  312.  
  313.    (setq v1list (entget (setq v1 (vertnext (car p)))))
  314.    (setq v2list (entget (setq v2 (vertnext v1))))
  315.  
  316.    ; Set the closing vertex equal to the starting vertex  (c1)
  317.  
  318.    (setq c1 v1
  319.          c1list v1list
  320.    )
  321.  
  322.    ; Set the center point for the array from the center line value
  323.  
  324.    (setq cenx (list cx (caddr (assoc 10 v1list))))
  325.  
  326.    ; Set the starting elevation to the center point's Z, plus the Y
  327.    ; coordinate of the first vertex relative to the start of the center line
  328.  
  329.    (setq elev (+ (caddr cen)
  330.                  (- (caddr (assoc 10 v1list)) cy)
  331.               )
  332.    )
  333.  
  334.    ; Create a selection set and save the current last entity
  335.  
  336.    (setq s (ssadd)
  337.          e (entlast)
  338.    )
  339.  
  340.    ; Process the vertices of the polyline ...
  341.  
  342.    (while (= (cdr (assoc 0 v2list)) "VERTEX")
  343.       (setq bulge (cdr (assoc 42 v1list)))
  344.       (if (= bulge 0)
  345.          (linseg)
  346.          (arcseg (cdr (assoc 10 v1list)) (cdr (assoc 10 v2list)) bulge)
  347.       )
  348.  
  349.       ; Reset the vertex lists for the next segment
  350.  
  351.       (setq v1 v2
  352.             v1list v2list
  353.             v2 (vertnext v1)
  354.             v2list (entget v2)
  355.       )
  356.    )
  357.  
  358.    ; Test for a closed polyline
  359.  
  360.    (if (= cflag 1)
  361.        (progn
  362.         (setq v2 c1
  363.               v2list c1list
  364.         )
  365.         (linseg)               ; Draw the closing linear segment
  366.        )
  367.    )
  368.  
  369.    ;  add all entities into the selection set
  370.  
  371.    (while (setq e (entnext e))
  372.       (ssadd e s)
  373.    )
  374.  
  375.    ; array all the entities
  376.  
  377.    (command "ARRAY" S "" "P" cen segno array-deg "")
  378.    (moder)                     ; Reset the system variables
  379.    (setq *error* olderr)
  380.    (princ)
  381. )
  382.